home *** CD-ROM | disk | FTP | other *** search
/ Amiga Plus 2000 #5 / Amiga Plus CD - 2000 - No. 5.iso / Tools / Dev / fpc / triton / examples / GadgetDemo.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2000-01-01  |  8.5 KB  |  279 lines
  1. PROGRAM GadgetDemo;
  2.  
  3. uses exec, triton, tritonmacros, utility, amigalib, vartags, amigautils, linklist,pastoc;
  4.  
  5. {
  6.    A demo in FPC Pascal using triton.library
  7.  
  8.    nils.sjoholm@mailbox.swipnet.se
  9. }
  10.  
  11.  
  12.  
  13. CONST
  14.  
  15.  
  16.     NumInList   =  7;
  17.     cyclenum    =  4;
  18.  
  19.     mxstrings : ARRAY[0..NumInList-1] OF PChar = (
  20.                                         'Amiga 500',
  21.                                         'Amiga 600',
  22.                                         'Amiga 1200',
  23.                                         'Amiga 2000',
  24.                                         'Amiga 3000',
  25.                                         'Amiga 4000',
  26.                                          NIL);
  27.  
  28.     cyclestrings : ARRAY[0..cyclenum-1] OF PChar = (
  29.                                         'Hallo',
  30.                                         'Moin',
  31.                                         'Tach',
  32.                                          NIL);
  33. CONST
  34.  
  35.     ButtonGadID      = 1;
  36.     CheckGadID       = 2;
  37.     ScrollGadID      = 3;
  38.     ScrollGadTextID  = 4;
  39.     SlidGadID        = 5;
  40.     SlidGadTextID    = 6;
  41.     CycleGadID       = 7;
  42.     CycleGadTextID   = 8;
  43.     StringGadID      = 9;
  44.     EntryGadID       = 10;
  45.     PassGadID        = 11;
  46.     MxGadID          = 12;
  47.     MxGadTextID      = 13;
  48.     ListGadID        = 14;
  49.  
  50. VAR
  51.     Triton_App  : pTR_App;
  52.     Project     : pTR_Project;
  53.     trmsg       : pTR_Message;
  54.     quit        : Boolean;
  55.     z           : Longint;
  56.     dummy       : Longint;
  57.     Mylist      : pList;
  58.     MyNode      : pFPCNode;
  59.     i           : Longint;
  60.     GadID       : Longint;
  61.  
  62. PROCEDURE CleanExit(errstring : STRING; rc : Longint);
  63. BEGIN
  64.     IF assigned(Project) THEN TR_CloseProject(Project);
  65.     if assigned(Triton_App) then TR_DeleteApp(Triton_App);
  66.     if assigned(MyList) then DestroyList(MyList);
  67.     IF errstring <> '' THEN WriteLn(errstring);
  68.     Halt(rc)
  69. END;
  70.  
  71. BEGIN
  72.  
  73.     CreateList(MyList);
  74.     FOR i := 0 TO NumInList-2 DO BEGIN
  75.         MyNode := AddNewNode(MyList,mxstrings[i]);
  76.     END;
  77.  
  78.     Triton_App := TR_CreateApp(TAGS(
  79.                      TRCA_Name,longstr('FPC Pascal Demo'),
  80.                      TRCA_LongName,Longstr('FPC Pascal Application Demo :)'),
  81.                      TRCA_Version,longstr('0.01'),
  82.                      TRCA_Info,longstr('Just a test of Triton'),
  83.                      TRCA_Release,longstr('1'),
  84.                      TRCA_Date,longstr('01-05-1996'),
  85.                      TAG_DONE));
  86.  
  87.     if Triton_App = NIL then CleanExit('Can''t create application',20);
  88.  
  89. ProjectStart;
  90.     WindowID(1);
  91.     WindowPosition(TRWP_CENTERDISPLAY);
  92.     WindowTitle('Gadgets');
  93.        HorizGroupAC;
  94.           Space;
  95.           VertGroupA;
  96.              Space;
  97.              NamedSeparator('Gadget deactivate');
  98.              Space;
  99.              Button('_Button',ButtonGadID);
  100.              Space;
  101.              HorizGroupSC;
  102.                 Space;
  103.                 HorizGroup;
  104.                    TextID('_Gadget activ?',CheckGadID);
  105.                    Space;
  106.                    CheckBoxCLEFT(CheckGadID);
  107.                 EndGroup;
  108.                 Space;
  109.              EndGroup;
  110.              SpaceB;
  111.              NamedSeparator('Pick value');
  112.              Space;
  113.              LineArray;
  114.                 BeginLine;
  115.                    TextID('Sc_roller',ScrollGadID);
  116.                    SetTRTag(TRAT_Flags,TROF_RIGHTALIGN);
  117.                    Space;
  118.                    SetTRTag(TROB_Scroller,TROF_HORIZ);
  119.                    SetTRTag(TRSC_Total,40);
  120.                    SetTRTag(TRSC_Visible,10);
  121.                    SetTRTag(TRAT_Value,5);
  122.                    SetTRTag(TRAT_ID,ScrollGadID);
  123.                    Space;
  124.                    ClippedTextBoxMW(pas2c('5'),ScrollGadTextID,2);
  125.                 EndLine;
  126.                 Space;
  127.                 BeginLine;
  128.                    TextID('S_lider',SlidGadID);
  129.                    SetTRTag(TRAT_Flags,TROF_RIGHTALIGN);
  130.                    Space;
  131.                    SliderGadget(1,50,25,SlidGadID);
  132.                    Space;
  133.                    ClippedTextBoxMW('25',SlidGadTextID,2);
  134.                 EndLine;
  135.                 Space;
  136.                 BeginLine;
  137.                    TextID('C_ycle',CycleGadID);
  138.                    SetTRTag(TRAT_Flags,TROF_RIGHTALIGN);
  139.                    Space;
  140.                    CycleGadget(@cyclestrings,0,CycleGadID);
  141.                    Space;
  142.                    ClippedTextBoxMW(cyclestrings[0],CycleGadTextID,5);
  143.                 EndLine;
  144.              EndArray;
  145.              SpaceB;
  146.               NamedSeparator('Type some Text');
  147.              Space;
  148.              LineArray;
  149.                 BeginLine;
  150.                    TextID('_String',StringGadID);
  151.                    SetTRTag(TRAT_Flags,TROF_RIGHTALIGN);
  152.                    Space;
  153.                    StringGadget('Please change',StringGadID);
  154.                    GetEntryButton(EntryGadID);
  155.                 EndLine;
  156.                 Space;
  157.                 BeginLine;
  158.                    TextID('_Password',PassGadID);
  159.                    SetTRTag(TRAT_Flags,TROF_RIGHTALIGN);
  160.                    Space;
  161.                    PasswordGadget('',PassGadID);
  162.                 EndLine;
  163.              EndArray;
  164.              Space;
  165.           EndGroup;
  166.           Space;
  167.           VertSeparator;
  168.           Space;
  169.           VertGroupAC;
  170.              Space;
  171.              NamedSeparatorI('C_hoose',MxGadID);
  172.              Space;
  173.              MXGadget(@mxstrings,4,MxGadID);
  174.              Space;
  175.              ClippedTextBox(mxstrings[4],MxGadTextID);
  176.              SpaceB;
  177.              NamedSeparatorI('D_oubleclick!',ListGadID);
  178.              Space;
  179.              ListSS(Mylist,ListGadID,0,0);
  180.           EndGroup;
  181.           Space;
  182.        EndGroup;
  183.     EndProject;
  184.  
  185.     Project := TR_OpenProject(Triton_App,@tritontags);
  186.  
  187.     IF Project = NIL THEN CleanExit('No project',20);
  188.  
  189.     quit := False;
  190.     WHILE NOT quit DO BEGIN
  191.       dummy := TR_Wait(Triton_App,0);
  192.       REPEAT
  193.         trmsg := TR_GetMsg(Triton_App);
  194.         IF trmsg <> NIL THEN BEGIN
  195.           IF (trmsg^.trm_Project = Project) THEN BEGIN
  196.              CASE trmsg^.trm_Class OF
  197.  
  198.                TRMS_CLOSEWINDOW :
  199.                BEGIN
  200.                  TR_LockProject(project);
  201.                  dummy := TR_EasyRequest(Triton_App,'%3Sure you want to end this demo?','Yes|No',NIL);
  202.                  TR_UnlockProject(project);
  203.                  IF dummy = 1 THEN quit := True;
  204.                END;
  205.  
  206.                TRMS_NEWVALUE :
  207.                BEGIN
  208.                  GadID := trmsg^.trm_ID;
  209.                  CASE GadID OF
  210.  
  211.                    CheckGadID :
  212.                    BEGIN
  213.                      dummy := trmsg^.trm_Data;
  214.                      IF dummy = 1 THEN BEGIN
  215.                         TR_Disable(project,ButtonGadID);
  216.                      END ELSE BEGIN
  217.                         TR_Enable(project,ButtonGadID);
  218.                         TR_SetString(project,StringGadID,'hello test');
  219.                      END;
  220.                    END;
  221.  
  222.                    ScrollGadID : TR_SetText(project,ScrollGadTextID,LongToStr(trmsg^.trm_Data));
  223.  
  224.                    SlidGadID   : TR_SetText(project,SlidGadTextID,LongToStr(trmsg^.trm_Data));
  225.  
  226.                    CycleGadID  : TR_SetText(project,CycleGadTextID,cyclestrings[trmsg^.trm_Data]);
  227.  
  228.                    StringGadID : ;
  229.  
  230.                    EntryGadID  : ;
  231.  
  232.                    PassGadID   : ;
  233.  
  234.                    MxGadID:
  235.                    BEGIN
  236.                      TR_SetText(project,MxGadTextID,mxstrings[trmsg^.trm_Data]);
  237.                      TR_SetValue(project,ListGadID,(trmsg^.trm_Data));
  238.                    END;
  239.  
  240.                    ListGadID :
  241.                    BEGIN
  242.                      TR_SetValue(project,MxGadID,(trmsg^.trm_Data));
  243.                      TR_SetText(project,MxGadTextID,mxstrings[trmsg^.trm_Data]);
  244.                    END;
  245.                  END;
  246.                END;
  247.  
  248.                TRMS_ACTION :
  249.                BEGIN
  250.                  GadID := trmsg^.trm_ID;
  251.                  CASE GadID OF
  252.  
  253.                    ButtonGadID :
  254.                    begin
  255.                      TR_LockProject(project);
  256.                      TR_EasyRequest(Triton_App,'You clicked on button ' + LongToStr(trmsg^.trm_ID),'_Aha',nil);
  257.                      TR_UnlockProject(Project);
  258.                    END;
  259.  
  260.                    EntryGadID:
  261.                    BEGIN
  262.                      TR_LockProject(project);
  263.                      z := TR_EasyRequest(Triton_App,TR_GetSTRPTR(project,StringGadID),'OK',NIL);
  264.                      TR_UnlockProject(Project);
  265.                    END;
  266.                  END;
  267.                END;
  268.                ELSE
  269.              END;
  270.            END;
  271.            TR_ReplyMsg(trmsg);
  272.          END;
  273.        UNTIL quit OR (trmsg = NIL);
  274.     END;
  275.     CleanExit('',0);
  276. END.
  277.  
  278.  
  279.